VERSION 5.00
Begin VB.Form Display 
   Caption         =   "Display"
   ClientHeight    =   3030
   ClientLeft      =   60
   ClientTop       =   510
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3030
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer tmrDebug 
      Enabled         =   0   'False
      Interval        =   20
      Left            =   1560
      Top             =   2520
   End
   Begin VB.Timer tmrAge 
      Interval        =   30
      Left            =   600
      Top             =   2520
   End
   Begin VB.Timer tmrAdd 
      Interval        =   500
      Left            =   120
      Top             =   2520
   End
   Begin VB.Timer tmrRainbow 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   1080
      Top             =   2520
   End
   Begin VB.Shape shpCircle 
      BorderWidth     =   5
      Height          =   135
      Index           =   0
      Left            =   120
      Shape           =   3  'Circle
      Tag             =   "TEMPLATE"
      Top             =   120
      Width           =   135
   End
End
Attribute VB_Name = "Display"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'TODO: Insert standard header

' The size at which, when reached, a shape triggers a child shape, in twips.
Const ChildTriggerSize As Integer = 500

' The size at, when reached, a shape triggers its own death, in twips.
Const DeathTriggerSize As Integer = 1500

' Increment of each 'grow' cycle of shape, in twips.
Const GrowIncrement As Byte = 25

' The maximum number of shapes in a group.
Const MaxShapesInGroup As Byte = 5

' The maximum number of shapes displayed at any one time (note: shapes added by the
' user clicking on the form do not respect this limit).
Dim MaxShapesDisplayed As Byte

' The time between adding each new shape is randomised, these variables contain
' the minimum and maximum intervals of this random duration.
Dim NewShapeMaxInterval As Integer
Dim NewShapeMinInterval As Integer

' Background colours are pulsed through different colours
Dim Rainbow As RainbowPulser

' The size of the shape's border is relative to its width. Border width is 0.5%
' of the shape's width.
Const ShapeBorderToWidthRatio As Single = 0.005

' The string used for seperating the group and child id components in a shape's
' tag.
Const TagComponentSeperator As String * 1 = "-"

' The tag of the template shape.
Const TemplateShapeTag As String = "TEMPLATE"

'#Region Private Methods

' Summary:
'   Adds a shape to the display.
' Params:
'   Parent:
'     If specified the new shape will be added as a child of this shape.
'   PositionX:
'     If specified (along with PositionY) the new shape will be placed at this X
'     co-ordinate; else the new shape will be randomly positioned. This parameter
'     is ignored if Parent is specified.
'   PositionY:
'     If specified (along with PositionX) the new shape will be placed at this Y
'     co-ordinate; else the new shape will be randomly positioned. This parameter
'     is ignored if Parent is specified.
Private Sub AddShape(Optional ByVal Parent, _
    Optional ByVal PositionX, Optional ByVal PositionY)
    
    ' Add a new shape
    Dim NewIndex As Long
    NewIndex = Me.shpCircle.UBound + 1
    
    Load Me.shpCircle(NewIndex)
    
    Dim NewShape As Shape
    Set NewShape = Me.shpCircle(NewIndex)
    
    
    ' Starting size
    NewShape.Width = 1
    NewShape.Height = 1
    
    
    ' Position
    If Not IsMissing(Parent) Then
        ' If we have specified a parent, use it to centre the new shape on its
        ' parent
        NewShape.Left = Parent.Left + (Parent.Width - NewShape.Width) / 2
        NewShape.Top = Parent.Top + (Parent.Height - NewShape.Height) / 2
    ElseIf Not IsMissing(PositionX) And Not IsMissing(PositionY) Then
        ' If we have specified x/y positions - use them
        NewShape.Left = PositionX
        NewShape.Top = PositionY
    Else
        ' Adding a new circle with a random position
        NewShape.Left = Math.Random(0, Me.ScaleWidth) - (NewShape.Width / 2)
        NewShape.Top = Math.Random(0, Me.ScaleHeight) - (NewShape.Height / 2)
    End If
    
    
    ' Shape
    If Not IsMissing(Parent) Then
        ' Take parents shape
        NewShape.Shape = Parent.Shape
    Else
        ' Random shape - 50% chance of circle, 25% square, 25% rounded square
        '                (because rounded squares look very similar to squares
        '                and otherwise we end up looking square-heavy)
        Dim RandomShape As Byte
        RandomShape = Math.Random(1, 4)
        Select Case RandomShape
            Case 2
                NewShape.Shape = vbShapeSquare
            Case 4
                NewShape.Shape = vbShapeRoundedSquare
            Case Else
                NewShape.Shape = vbShapeCircle
        End Select
    End If
    
    
    ' Colour
    NewShape.BorderColor = Colour.RandomColour()
    
    
    ' Tag
    Dim GroupId As Long
    If Not IsMissing(Parent) Then
        ' Take the parent's group id for the new shape
        GroupId = GetGroupIdFromTag(Parent.Tag)
    Else
        ' Obtain a new group id
        GroupId = GetNewGroupId()
    End If
    
    Dim ChildId As Byte
    ChildId = GetNewChildId(GroupId)
    
    Dim Tag As String
    Tag = BuildTag(GroupId, ChildId)
    
    NewShape.Tag = Tag
    
    
    ' Show new shape
    NewShape.Visible = True
End Sub

' Summary:
'   Adds a new shape at the current position of the mouse pointer.
Private Sub AddShapeAtMousePosition()
    Dim MousePosition As POINTAPI
    MousePosition = Mouse.MouseXY(Me.hwnd)
    
    ' MousePosition is in pixels, convert to twips
    Dim MouseX As Long, MouseY As Long
    MouseX = MousePosition.X * Screen.TwipsPerPixelX
    MouseY = MousePosition.Y * Screen.TwipsPerPixelY
    
    AddShape , MouseX, MouseY
End Sub

' Summary:
'   Initialise some values and start the animation.
Private Sub BeginAnimation()
    ' Set initial new circle interval values
    NewShapeMinInterval = 250
    NewShapeMaxInterval = 2000
    
    ' Set initial maximum number of shapes
    MaxShapesDisplayed = 5
    
    ' Hide the template shape
    Me.shpCircle(0).Visible = False
    
    ' Initialise the rainbow pulser
    Set Rainbow = New RainbowPulser
    Set Rainbow.Form = Me
    
    ' Randomise the initial background colour of the form
    Me.BackColor = Colour.RandomColour()
    
    ' Set form caption
    Me.Caption = App.Title
    
    ' Add a new circle
    AddShape
 
    ' Set 'rainbow' timer interval and engage it
    Me.tmrRainbow.Interval = 250
    Me.tmrRainbow.Enabled = True
End Sub

' Summary:
'   Ages the specified shape. A shape grows, has children and ultimately dies.
' Params:
'   ShapeToAge:
'     The shape to age.
Private Sub AgeShape(ByVal ShapeToAge As Shape)
    ' Don't molest the template shape
    If ShapeToAge.Tag = TemplateShapeTag Then Exit Sub
    
    ' Grow the shape
    Dim OldWidth As Long, OldHeight As Long
    OldWidth = ShapeToAge.Width
    OldHeight = ShapeToAge.Height
    
    Dim NewWidth As Long, NewHeight As Long
    NewWidth = OldWidth + GrowIncrement
    NewHeight = OldHeight + GrowIncrement
    
    ShapeToAge.Width = NewWidth
    ShapeToAge.Height = NewHeight
    
    
    ' Grow from the centre
    Dim DeltaWidth As Long, DeltaHeight As Long
    DeltaWidth = NewWidth - OldWidth
    DeltaHeight = NewHeight - OldHeight
    
    ShapeToAge.Left = ShapeToAge.Left - (DeltaWidth / 2)
    ShapeToAge.Top = ShapeToAge.Top - (DeltaHeight / 2)
    
    
    ' Get chunkier as the shape gets bigger
    ' 0.5% of the width
    Dim BorderWidth As Integer
    BorderWidth = ShapeToAge.Width * ShapeBorderToWidthRatio
    If BorderWidth < 1 Then
        BorderWidth = 1
    End If
    
    ShapeToAge.BorderWidth = BorderWidth
    
    
    ' Have we reached the trigger point to add a child?
    If ShapeToAge.Width > ChildTriggerSize Then
        ' Don't add any more children if we've reached the limit
        If GetChildIdFromTag(ShapeToAge.Tag) < MaxShapesInGroup Then
            ' Don't add a child if this shape already has a direct child
            If Not ShapeHasChild(ShapeToAge.Tag) Then
                ' Give the shape a child
                AddShape ShapeToAge
            End If
        End If
    End If
    
    
    ' Have we reached the trigger point for death?
    If ShapeToAge.Width > DeathTriggerSize Then
        Unload ShapeToAge
    End If
End Sub

' Summary:
'   Ages all displayed shapes.
Private Sub AgeShapes()
    Dim Control As Control
    For Each Control In Me.shpCircle
        AgeShape Control
    Next Control
End Sub

' Summary:
'   Obtains a shape tag composited of the specified group and child ids.
' Params:
'   GroupId:
'     The group id to encode into the tag.
'   ChildId:
'     The child id to encode into the tag.
' Example:
'   Dim Tag As String
'   Tag = BuildTag(3, 2)
'   'Tag is "3-2"
Private Function BuildTag(ByVal GroupId As Byte, ByVal ChildId As Byte) As String
    Dim Tag As String
    Tag = CStr(GroupId) & TagComponentSeperator & CStr(ChildId)
    
    BuildTag = Tag
End Function

' Summary:
'   Calculates the maximum number of displayed groups in relation to the available
'   display area.
Private Function CalculateMaxDisplayedGroups()
    ' The maximum number of displayed groups is a function of the size of the
    ' display area.
    '
    ' 15% of the display area is designated for displaying shapes
    ' Actually no, that isn't quite what we're doing. But again, it looks nice
    ' enough.
    
    
    ' Calculate the size of the display area
    Dim DisplayArea As Long
    DisplayArea = Me.ScaleHeight * Me.ScaleWidth
    
    ' Calculate the size of a (fully grown) shape
    Dim ShapeArea As Long
    ShapeArea = DeathTriggerSize ^ 2
    
    Dim MaxNumShapes As Integer
    MaxNumShapes = DisplayArea / (ShapeArea + 0.15 * DisplayArea)
    
    CalculateMaxDisplayedGroups = MaxNumShapes
End Function

' Summary:
'   Displays debug information.
Private Function DisplayDebugInfo()
    Me.Cls
    
    Me.Print "Age Timer Enabled:           " & Me.tmrAge.Enabled
    Me.Print "Age Timer Interval:          " & Me.tmrAge.Interval
    Me.Print "Add Timer Enabled:           " & Me.tmrAdd.Enabled
    Me.Print "Add Timer Interval:          " & Me.tmrAdd.Interval
    
    Dim Red As Byte, Green As Byte, Blue As Byte
    Call Colour.Long2RGB(Me.BackColor, Red, Green, Blue)
    Me.Print "Background Colour:           " & "RGB(" & Red & ", " & Green & ", " & Blue & ")"
    
    Me.Print "Child Trigger Size:          " & ChildTriggerSize
    Me.Print "Death Trigger Size:          " & DeathTriggerSize
    Me.Print "Debug Timer Enabled:         " & Me.tmrDebug.Enabled
    Me.Print "Debug Timer Interval:        " & Me.tmrDebug.Interval
    Me.Print "Display Width:               " & Me.ScaleWidth
    Me.Print "Display Height:              " & Me.ScaleHeight
    Me.Print "Display Area:                " & Me.ScaleWidth * Me.ScaleHeight
    Me.Print "Grow Increment:              " & GrowIncrement
    Me.Print "Max Shape Area:              " & DeathTriggerSize ^ 2
    Me.Print "Max Shapes In Group:         " & MaxShapesInGroup
    Me.Print "Max Shapes Displayed:        " & MaxShapesDisplayed
    Me.Print "New Shape Max Interval:      " & NewShapeMaxInterval
    Me.Print "New Shape Min Interval:      " & NewShapeMinInterval
    Me.Print "Number Of Displayed Groups:  " & GetNumberOfDisplayedGroups()
    Me.Print "Rainbow Timer Enabled:       " & Me.tmrRainbow.Enabled
    Me.Print "Rainbow Timer Interval:      " & Me.tmrRainbow.Interval
    Me.Print "Shape Border To Width Ratio: " & ShapeBorderToWidthRatio
End Function

' Summary:
'   Obtains the child id component from a shape tag.
' Params:
'   Tag:
'     The shape tag from which to extract the child id component.
' Remarks:
'   Tag should be a string encoding the group and child ids, e.g. "2-4"
Private Function GetChildIdFromTag(ByVal Tag As String) As Byte
    Dim ChildIdComponent As Byte
    
    ChildIdComponent = Split(Tag, TagComponentSeperator)(1)
    
    GetChildIdFromTag = ChildIdComponent
End Function

' Summary:
'   Obtains the group id component from a shape tag.
' Params:
'   Tag:
'     The shape tag from which to extract the group id component.
' Remarks:
'   Tag should be a string encoding the group and child ids, e.g. "2-4"
Private Function GetGroupIdFromTag(ByVal Tag As String) As Long
    Dim GroupIdComponent As Long
    
    GroupIdComponent = Split(Tag, TagComponentSeperator)(0)
    
    GetGroupIdFromTag = GroupIdComponent
End Function

' Summary:
'   Obtains a new child id for the specified group.
' Params:
'   The id of the group for which to obtain a new child id.
Private Function GetNewChildId(ByVal GroupId As Long) As Byte
    Dim Highest As Byte
    Dim Control As Control
    For Each Control In Me.shpCircle
        If Control.Tag <> TemplateShapeTag Then
            If GetGroupIdFromTag(Control.Tag) = GroupId Then
                Dim ChildId As Byte
                ChildId = GetChildIdFromTag(Control.Tag)
                If ChildId > Highest Then
                    Highest = ChildId
                End If
            End If
        End If
    Next Control
    
    GetNewChildId = Highest + 1
End Function

' Summary:
'   Obtains a new group id.
Private Function GetNewGroupId() As Long
    ' Find the lowest group id that is not currently being used, this allows us
    ' to re-use group ids as older groups are removed
    
    Dim GroupId As Long
    Dim GroupIdInUse As Boolean
    Do
        GroupId = GroupId + 1
        GroupIdInUse = False
        
        Dim ChildId As Byte
        For ChildId = 1 To MaxShapesInGroup
            Dim Tag As String
            Tag = BuildTag(GroupId, ChildId)
            If ShapeExists(Tag) Then
                GroupIdInUse = True
                Exit For
            End If
        Next ChildId
    Loop While GroupIdInUse
    
    GetNewGroupId = GroupId
End Function

' Summary:
'   Obtains the number of currently displayed shape groups.
Private Function GetNumberOfDisplayedGroups() As Byte
    Dim GroupIds()
    ReDim GroupIds(0)
    
    Dim Control As Control
    For Each Control In Me.shpCircle
        If Control.Tag <> TemplateShapeTag Then
            Dim GroupId As Long
            GroupId = GetGroupIdFromTag(Control.Tag)
            
            Dim AddGroupId As Boolean
            AddGroupId = True
            Dim Id
            For Each Id In GroupIds
                If Id = GroupId Then
                    AddGroupId = False
                    Exit For
                End If
            Next Id
            
            If AddGroupId Then
                Dim NewIndex
                NewIndex = UBound(GroupIds) + 1
                ReDim Preserve GroupIds(NewIndex)
                GroupIds(NewIndex) = GroupId
            End If
        End If
    Next Control
    
    GetNumberOfDisplayedGroups = UBound(GroupIds)
End Function

' Summary:
'   Initialises the debug information display.
Private Function InitialiseDebugInfo()
    Me.Font = "Courier New"
    Me.FontSize = 10
    
    ' Enable the debug info timer
    tmrDebug.Enabled = True
End Function

' Summary:
'   Recalculates the minimum possible interval between adding new shapes.
Private Sub ReculateNewShapeInterval()
    ' The smallest possible interval (it's randomised) for adding a shape is
    ' a function of the size of the display area. But for the life of me I can't
    ' remember why I ended up with this particular function. Seems to work
    ' though.
    
    NewShapeMinInterval = _
        250 / (((Me.ScaleHeight / 1000) * (Me.ScaleWidth / 1000)) / 15)
End Sub

' Summary:
'   Recalculates the maximum number of displayed groups.
Private Sub RecalculateMaxDisplayedGroups()
    If Program.Settings.MaximumShapesDisplayed = _
       SettingsHelper.MaximumShapesDisplayed_AutomaticValue Then
       
        ' Automatically calculate the maximum number of displayed groups
        ' using the size of the display area
        
        MaxShapesDisplayed = CalculateMaxDisplayedGroups()
       
    Else
        
        ' The maximum number of displayed groups is set by the user
        
        MaxShapesDisplayed = Program.Settings.MaximumShapesDisplayed
        
    End If
End Sub

' Summary:
'   Obtains a boolean value indicating whether the shape with the specified tag
'   has a _direct_ child.
' Params:
'   Tag:
'     The tag of the shape to test for parentage.
Private Function ShapeHasChild(ByVal Tag As String) As Boolean
    Dim GroupId As Byte
    GroupId = GetGroupIdFromTag(Tag)
    
    Dim ChildId As Byte
    ChildId = GetChildIdFromTag(Tag)
    
    Dim DescendantChildId As Byte
    DescendantChildId = ChildId + 1
    
    Dim DescendantTag As String
    DescendantTag = BuildTag(GroupId, DescendantChildId)
    
    ShapeHasChild = ShapeExists(DescendantTag)
End Function

' Summary:
'   Obtains a boolean value indicating whether a shape with the specified tag
'   exists.
' Params:
'   Tag:
'     The tag of a shape to test for existence.
Private Function ShapeExists(ByVal Tag As String) As Boolean
    Dim Shape
    For Each Shape In Me.shpCircle
        If Shape.Tag = Tag Then
            ShapeExists = True
            Exit Function
        End If
    Next Shape
End Function

'#End Region

'#Region Event Handlers

' Summary:
'   Event handler for Form's Load event.
Private Sub Form_Load()
    Call BeginAnimation
    
    ' Show debug information in debug mode
    If Program.IsDebug Then
        Call InitialiseDebugInfo
    End If
End Sub

' Summary:
'   Event handler for Form's MouseUp event.
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, _
    Y As Single)
    
    If Button = vbKeyLButton Then
        ' Add a new shape at the clicked co-ordinates
        AddShapeAtMousePosition
    ElseIf Button = vbKeyRButton Then
        ' TODO: Show context menu
        '
        ' Settings
        ' -
        ' About
    End If
End Sub

' Summary:
'   Event handler for Form's Resize event.
Private Sub Form_Resize()
    ReculateNewShapeInterval
    RecalculateMaxDisplayedGroups
End Sub

' Summary:
'   Event handler for tmrAdd's Timer event. Adds a shape to the new display
'   within the limits.
Private Sub tmrAdd_Timer()
    If GetNumberOfDisplayedGroups() < MaxShapesDisplayed Then
        Call AddShape
        
        ' Randomise the interval between adding new circles
        tmrAdd.Interval = Math.Random(NewShapeMinInterval, NewShapeMaxInterval)
        
    End If
End Sub

' Summary:
'   Event handler for tmrAge's Timer event. Ages all shapes on the display.
Private Sub tmrAge_Timer()
    Call AgeShapes
End Sub

' Summary:
'   Event handler for tmrDebug's Timer event.
Private Sub tmrDebug_Timer()
    DisplayDebugInfo
End Sub

' Summary:
'   Event handler for tmrRainbow's Timer event. Pulses the background colour of
'   the form.
Private Sub tmrRainbow_Timer()
    Rainbow.Pulse
End Sub

'#End Region
